home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gwu / 9.c < prev    next >
C/C++ Source or Header  |  1996-01-30  |  18KB  |  637 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. #include "hdr.h"
  10. #include "vars.h"
  11. #include "setp.h"
  12. #include "errmsgp.h"
  13. #include "miscp.h"
  14. #include "smiscp.h"
  15. #include "nodesp.h"
  16. #include "dclmapp.h"
  17. #include "chapp.h"
  18.  
  19. void task_spec(Node task_node)                                /*;task_spec*/
  20. {
  21.     Node    entries_node, id_node;
  22.     int        anon;
  23.     Symbol    task_type_name, t_name, old_kind, entry_sym;
  24.     char    *id;
  25.     Declaredmap    entry_list;
  26.     Fordeclared fd1;
  27.  
  28.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  task_spec");
  29.  
  30.     id_node = N_AST1(task_node);
  31.     entries_node = N_AST2(task_node);
  32. #ifdef TBSN
  33.     /* ignore opt_specs_node for now, as N_AST3 used for N_TYPE
  34.      * DS  9-22-86
  35.      */
  36.     opt_specs_node = N_AST3(task_node);
  37. #endif
  38.     /*
  39.      * If this is a task declaration, an anonymous task type is introduced
  40.      * for it. Entry declarations are always attached to the task type.
  41.      * TBSL : processing of specifications.
  42.      */
  43.     anon = (N_KIND(task_node) == as_task_spec);
  44.     id = N_VAL(id_node);
  45.     if (anon)
  46.         task_type_name =
  47.            find_new(strjoin(strjoin("task_type:", id), newat_str()));
  48.     else
  49.         task_type_name = find_type_name(id_node);
  50.  
  51.     if (task_type_name == symbol_any) return; /* Illegal redeclaration. */
  52.  
  53.     if (anon) {
  54. #ifdef TBSN
  55.         XREF lessf:= task_type_name;
  56. #endif
  57.     }
  58.     old_kind = TYPE_OF(task_type_name); /* may have been private */
  59.  
  60.     NATURE(task_type_name) = na_task_type_spec;
  61.     TYPE_OF(task_type_name) = task_type_name;
  62.     SIGNATURE(task_type_name) = tup_new(0);  /* created by the expander */
  63.     root_type(task_type_name) = task_type_name;
  64.     initialize_representation_info(task_type_name, TAG_TASK);
  65.     /* priv_types is {private, limited_private}; first arg to check_priv_decl
  66.      * is one of MISC_TYPE_ATTRIBUTES ...
  67.      */
  68.     if (old_kind == symbol_private)
  69.         check_priv_decl(TA_PRIVATE, task_type_name);
  70.     else if (old_kind == symbol_limited_private)
  71.         check_priv_decl(TA_LIMITED_PRIVATE, task_type_name);
  72.     if (anon) {
  73.         t_name = find_new(id);
  74.         NATURE(t_name) = na_task_obj_spec;
  75.         TYPE_OF(t_name) = task_type_name;
  76.         SIGNATURE(t_name) = (Tuple) 0;
  77.         N_UNQ(task_node) = t_name;
  78.     }
  79.  
  80.     N_TYPE(task_node) = task_type_name;
  81.     newscope(task_type_name);    /* introduce new scope */
  82. #ifdef TBSN
  83.     prefix := prefix + id + '.';            $ For unique names.
  84. #endif
  85.         sem_list(entries_node);
  86. #ifdef TBSN
  87.     /* ignore opt_specs_node for now, as N_AST3 used for N_TYPE
  88.      * DS  9-22-86
  89.      */
  90.     sem_list(opt_specs_node);
  91. #endif
  92.  
  93.     entry_list = DECLARED(scope_name);
  94.     popscope();
  95.  
  96.     if (anon) {
  97.         /* Attach entry declarations for task object as well, and emit a
  98.          * declaration for the task object itself.
  99.          */
  100.         SIGNATURE(t_name) = (Tuple) 0;
  101.         DECLARED(t_name) = entry_list;
  102.  
  103.         FORDECLARED(id, entry_sym, entry_list, fd1)
  104.             /*(for entry = entry_list(id))*/
  105.             SCOPE_OF(entry_sym) = t_name;
  106.         ENDFORDECLARED(fd1)
  107.     }
  108.     return;
  109. }
  110.  
  111. void accept_statement(Node accept_node)                    /*;accept_statement*/
  112. {
  113.  
  114.     /* This procedure opens a new scope when an ACCEPT statement is seen.
  115.      * In the case of an overloaded entry name, it selects the one with
  116.      * the matching signature.
  117.      */
  118.  
  119.     int        certain;
  120.     Symbol    task_name, task_type, real_name, entry_name, ix_t;
  121.     Set        entries;
  122.     Tuple    formals;
  123.     Forset    fs1;
  124.     Node    id_node, indx, body_node;
  125.     Node    formals_node;
  126.     int        exists, nat;
  127.     char    *id, *junk;
  128.     Fortup    ft1;
  129.  
  130.     if (cdebug2 > 3) TO_ERRFILE("AT PROC : accept_statement");
  131.  
  132.     id_node = N_AST1(accept_node);
  133.     indx = N_AST2(accept_node);
  134.     formals_node = N_AST3(accept_node);
  135.     body_node = N_AST4(accept_node);
  136.  
  137.     id = N_VAL(id_node);
  138.     formals = get_formals(formals_node, id);
  139.     /* Find the task  in which the accept statement occurs. The accept
  140.      * may of course appear within a block or another accept statement.
  141.      */
  142.  
  143.     exists    = FALSE;
  144.     FORTUP(task_name = (Symbol), open_scopes, ft1);
  145.         nat = NATURE(task_name);
  146.         if( nat != na_block && nat != na_entry && nat != na_entry_family) {
  147.             exists = TRUE;
  148.             break;
  149.         }
  150.     ENDFORTUP(ft1);
  151.     certain = exists;
  152.     task_type = TYPE_OF(task_name);
  153.  
  154.     if (task_type == (Symbol)0 || NATURE(task_type) != na_task_type)  {
  155.         errmsg("Accept statements can only appear in tasks","9.5", accept_node);
  156.         /* following junk line in SETL not needed here    ds 1 nov 84
  157.          * entry_name = id;
  158.          */
  159.         return;
  160.     }
  161.  
  162.     real_name = entry_name = dcl_get(DECLARED(task_name), id);
  163.  
  164.     if (entry_name == (Symbol)0) {
  165.         errmsg("Undefined entry name in ACCEPT ", "9.5", id_node);
  166. #ifdef TBSL
  167.         -- entry_name is symbol, id is string        ds 2-jan-85
  168.             entry_name = id; /* For dummy scope. */
  169. #endif
  170.         return; /* to Initialize it . */
  171.     }
  172.     else if (NATURE(entry_name) == na_entry) {
  173.         /* Collect all its overloadings and select the one with the
  174.          * correct signature.
  175.          */
  176.         entries = OVERLOADS(entry_name);
  177.  
  178.         if (indx != OPT_NODE) {
  179.             errmsg("invalid index on entry (not entry family)", "9.5", indx);
  180.         }
  181.  
  182.         exists = FALSE;
  183.         FORSET(entry_name = (Symbol), entries, fs1);
  184.             if (same_sig_spec(entry_name, formals)) {
  185.                 exists = TRUE;
  186.                 break;
  187.             }
  188.         ENDFORSET(fs1);
  189.         if (!exists) {
  190.             errmsg("Entry name in ACCEPT statement does not match any entry" ,
  191.               "9.5", id_node);
  192.             return;
  193.         }
  194.     }
  195.     else if (NATURE(entry_name) == na_entry_family) {
  196.         ix_t = (Symbol) index_type(TYPE_OF(entry_name));
  197.  
  198.         if (indx == OPT_NODE) {
  199.             errmsg("Missing index for entry family.", "9.5", accept_node);
  200.         }
  201.         else {
  202.             adasem(indx);
  203.             check_type(ix_t, indx);
  204.         }    
  205.     }
  206.     else {
  207.         errmsg("Invalid entry name in ACCEPT", "9.5", id_node);
  208.         return;
  209.     }
  210.  
  211.     N_UNQ(id_node) = entry_name;
  212.     TO_XREF(entry_name);
  213.  
  214.     reprocess_formals(entry_name, formals_node);
  215.     if (in_open_scopes(entry_name )) {
  216.         errmsg_l("An accept_statement cannot appear within an ACCEPT for",
  217.           " the same entry", "9.5", accept_node);
  218.     }
  219.     newscope(entry_name);
  220.     has_return_stk = tup_with(has_return_stk, (char *)FALSE);
  221.     adasem(body_node);
  222.     junk = tup_frome(has_return_stk);
  223.     popscope();
  224. }
  225.  
  226. void entry_decl(Node entry_node)                            /*;entry_decl*/
  227. {
  228.     /* An entry declaration is treated like a procedure specification.
  229.      * An anonymous type is created for the entry object. This type is
  230.      * used by the interpreter to build the environment of an entry.
  231.      */
  232.  
  233.     Symbol    entry_sym, entry_type;
  234.     Node    id_node, formal_list;
  235.     Tuple    formals;
  236.  
  237.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  entry_decl");
  238.  
  239.     id_node = N_AST1(entry_node);
  240.     formal_list = N_AST2(entry_node);
  241.  
  242.     formals = get_formals(formal_list, N_VAL(id_node));
  243.  
  244.     check_out_parameters(formals);
  245.  
  246.     /*entry = chain_overloads(N_VAL(id_node), [na_entry, 'none', formals]); */
  247.     entry_sym = chain_overloads(N_VAL(id_node), na_entry, symbol_none,
  248.       formals, (Symbol)0, formal_list);
  249.  
  250.     entry_type = anonymous_type();
  251.  
  252.     /*SYMBTAB(entry_type) := [na_entry_former, scope_name, signature(entry)]; */
  253.     NATURE(entry_type) = na_entry_former;
  254.     TYPE_OF(entry_type) = scope_name;
  255.     SIGNATURE(entry_type) = SIGNATURE(entry_sym);
  256.     root_type(entry_type) = entry_type;
  257.  
  258.     N_UNQ(id_node)    = entry_sym;
  259.     N_TYPE(entry_node) = entry_type;
  260. }
  261.  
  262. void entry_family_decl(Node entry_node)                    /*;entry_family_decl*/
  263. {
  264.     /* An entry family  is not  an overloadable  object. It     is  constructed
  265.      * as an array of entries. An anonymous type is introduced for the entry
  266.      * former, just     as for an  entry declaration, and another is introduced
  267.      * for the array representing the family.
  268.      */
  269.  
  270.     Symbol    entry_sym, entry_type, family_type;
  271.     Symbol    opt_range;
  272.     Tuple    formals, f, tup;
  273.     Node    id_node, discrete_range, formal_list;
  274.  
  275.     if (cdebug2 > 3) TO_ERRFILE("AT PROC : entry_family_decl");
  276.  
  277.     id_node = N_AST1(entry_node);
  278.     discrete_range = N_AST2(entry_node);
  279.     formal_list = N_AST3(entry_node);
  280.  
  281.     entry_sym = find_new(N_VAL(id_node));
  282.  
  283.     formals = get_formals(formal_list, N_VAL(id_node));
  284.  
  285.     check_out_parameters(formals);
  286.  
  287.     f = process_formals(entry_sym, formals, TRUE);
  288.  
  289.     entry_type = anonymous_type();
  290.  
  291.     NATURE(entry_type) = na_entry_former;
  292.     TYPE_OF(entry_type) = scope_name;
  293.     SIGNATURE(entry_type) = f;
  294.     root_type(entry_type) = entry_type;
  295.     adasem(discrete_range);
  296.     opt_range = make_index(discrete_range);
  297.     family_type = anonymous_type();
  298.     /* SYMBTAB(family_type) =
  299.      *        [na_array, family_type, [[opt_range], entry_type]];
  300.      */
  301.     NATURE(family_type) = na_array;
  302.     TYPE_OF(family_type) = family_type;
  303.     tup = tup_new(2);
  304.     tup[1] = (char *) tup_new1((char *) opt_range);
  305.     tup[2] = (char *) entry_type;
  306.     SIGNATURE(family_type) = (Tuple) tup;
  307.     root_type(family_type) = family_type;
  308.  
  309.     /* SYMBTAB(entry) = [na_entry_family, family_type, f]; */
  310.     NATURE(entry_sym) = na_entry_family;
  311.     TYPE_OF(entry_sym) = family_type;
  312.     SIGNATURE(entry_sym) = f;
  313.     formal_decl_tree(entry_sym) = (Symbol) formal_list;
  314.     N_UNQ(id_node) = entry_sym;
  315.     N_TYPE(entry_node) = family_type;
  316. }
  317.  
  318. void entry_call(Node node)                                    /*;entry_call*/
  319. {
  320.     /* process an entry call. obj_node below is the entry name: either a se-
  321.      * lected or an indexed expression.
  322.      */
  323.  
  324.     Symbol    range_typ, entry_sym;
  325.     Node    obj_node, arg_list_node;
  326.     Tuple    arg_list;
  327.     Node    task_node, index_node, entry_node;
  328.  
  329.     if (cdebug2 > 3) TO_ERRFILE("AT PROC :  entry_call");
  330.  
  331.     obj_node = N_AST1(node);
  332.     arg_list_node = N_AST2(node);
  333.  
  334.     arg_list = N_LIST(arg_list_node);
  335.  
  336.     find_entry_name(obj_node); /* Normalize entry name*/
  337.     task_node = N_AST1(obj_node);
  338.     entry_node = N_AST2(obj_node);
  339.  
  340.     if (entry_node == OPT_NODE) return;    /* previous error. */
  341.  
  342.     if (N_KIND(obj_node) == as_entry_family_name) {
  343.         entry_sym = N_UNQ(entry_node);
  344.         range_typ = (Symbol) index_type(TYPE_OF(entry_sym));
  345.         index_node = N_AST3(obj_node);
  346.  
  347.         if (index_node == OPT_NODE) {
  348.             /* Case of a call to a parameterless family. The formals list
  349.              * is actually the index expression. Verify its size.
  350.              */
  351.             if (tup_size(arg_list) != 1) {
  352.                 errmsg("Call to member of entry family requires one index",
  353.                   "9.5, 3.6.1", obj_node);
  354.                 return;
  355.             }
  356.             else {
  357.                 index_node = (Node) arg_list[1];
  358.                 N_AST3(obj_node) = index_node;
  359.  
  360.                 arg_list_node = node_new(as_list);
  361.                 N_LIST(arg_list_node) = tup_new(0);
  362.  
  363.                 N_AST2(node) = arg_list_node;
  364.             }
  365.         }
  366.  
  367.         check_type(range_typ, index_node);
  368.  
  369.         /* process as usual call.*/
  370.         N_NAMES(obj_node) = set_new1((char *) entry_sym);
  371.         check_type(TYPE_OF(entry_sym), node);
  372.         N_AST3(obj_node) = index_node;     /* restore index */
  373.         N_KIND(obj_node) = as_entry_name;  /* common processing after this */
  374.     }
  375.     else {    /* Simple entry.*/
  376.         check_type(symbol_none, node);    /* as for a procedure call */
  377.         entry_sym = N_UNQ(entry_node);
  378.         N_AST3(obj_node) = OPT_NODE;      /* discard  N_NAMES  */
  379.     }
  380.     /*  Having resolved the call, use the unique entry name to complete the
  381.      *  resolution of the task name itself.
  382.      */
  383.     if (entry_sym != (Symbol)0)
  384.         complete_task_name(task_node, TYPE_OF(SCOPE_OF(entry_sym)));
  385.  
  386.     return;
  387. }
  388.  
  389. void check_entry_call(Node stat_node)                    /*;check_entry_call*/
  390. {
  391.     /* Verify that the call in a timed entry call or a conditional entry call
  392.      * is indeed a call to an entry, and not to a procedure.
  393.      */
  394.  
  395.     adasem(stat_node);
  396.  
  397.     if (N_KIND(stat_node) == as_call) {
  398.         errmsg("context requires entry name ", "9.7.2, 7.3", stat_node);
  399.     }
  400. }
  401.  
  402. void find_entry_name(Node obj_node)                        /*;find_entry_name*/
  403. {
  404.     /* Find the name of an entry or entry family, given by a qualified and
  405.      * (in the case of a family) indexed expression. This differs from other
  406.      * cases of name resolution in that the name of the task containing the
  407.      * entry can be given by an expression that must also be resolved.
  408.      * This procedure is also called to validate the argument of the COUNT
  409.      * attribute; this attribute can only be used within the task body, in
  410.      * which the entry need not be named as a selected component. An entry
  411.      * name will then be seen as an overloaded identifier. The task name is
  412.      * the scope of the entry.
  413.      * An entry family name is built as a triple [task_node, entry_node, index]
  414.      * An entry name is built as a pair [task_node, entry_name]. In addition,
  415.      * the N_NAMES field is defined in the case of entries, which can be over-
  416.      * loaded.
  417.      */
  418.  
  419.     Node    index_list_node, task_node, entry_node, index_node;
  420.     Tuple    index_list;
  421.     Symbol    obj, task_name, t, e, sym;
  422.     Set        entries, task_types, entry_names;
  423.     Forset    fs1, fs2;
  424.     char    *entry_id;
  425.     int exists, is_family;
  426.  
  427.     if (cdebug2 > 3 ) TO_ERRFILE("AT PROC :  find_entry_name");
  428.  
  429.     if (N_KIND(obj_node) == as_simple_name) {
  430.         if (N_OVERLOADED(obj_node) ) {
  431.             entries = N_NAMES(obj_node);
  432.             task_name = SCOPE_OF((Symbol)set_arb( entries));
  433.  
  434.             if (!is_task_type(TYPE_OF(task_name))) {
  435.                 errmsg("Invalid entry name", "9.5", obj_node);
  436.                 entry_node = OPT_NODE;
  437.             }
  438.             else {
  439.                 entry_node = copy_node(obj_node);
  440.             }
  441.  
  442.             task_node = node_new(as_simple_name);
  443.             N_UNQ(task_node) = task_name;
  444.             N_VAL(task_node) = (char *) original_name(task_name);
  445.             copy_span(obj_node, task_node);
  446.  
  447.             index_node = OPT_NODE;
  448.         }
  449.         else if (NATURE((obj = N_UNQ(obj_node))) == na_entry_family) {
  450.             /* Member of entry family, with index missing. */
  451.             errmsg("Missing index in name of member of entry family",
  452.               "9.5", obj_node);
  453.             entry_node = OPT_NODE;
  454.         }
  455.     }
  456.     else if (N_KIND(obj_node) == as_selector) { /* selected_component*/
  457.         task_node = N_AST1(obj_node);
  458.         entry_node = N_AST2(obj_node);
  459.         index_node = OPT_NODE;
  460.     }
  461.     else {    /* case of entry family. */
  462.         entry_node = N_AST1(obj_node);
  463.         index_list_node = N_AST2(obj_node);
  464.  
  465.         if (N_KIND(entry_node) == as_simple_name) {
  466.             /* Entry family named in task body. Get enclosing task name.*/
  467.  
  468.             task_node = node_new(as_simple_name);
  469.             task_name = SCOPE_OF(N_UNQ(entry_node));
  470.             N_UNQ(task_node) = task_name;
  471.             N_VAL(task_node) = (char *) original_name(task_name);
  472.             copy_span(obj_node, task_node);
  473.         }
  474.         else {/* Name is selected component. */
  475.             task_node = N_AST1(entry_node);
  476.             entry_node = N_AST2(entry_node);
  477.         }
  478.  
  479.         index_list = N_LIST(index_list_node);
  480.         if (tup_size(index_list) != 1) {
  481.             errmsg("Member of entry family requires a single index ",
  482.               "9.5, 3.6.1", obj_node);
  483.             entry_node = OPT_NODE;
  484.         }
  485.         index_node = (Node) index_list[1];/* In any case. */
  486.     }
  487.  
  488.     if (entry_node != OPT_NODE) {        /* no previous error*/
  489.         valid_task_name(task_node);
  490.         task_types = N_PTYPES(task_node);
  491.         if (set_size(task_types) == 0)        /* prefix is not a task*/
  492.             entry_node = OPT_NODE;
  493.     }
  494.     else {
  495.         task_node = OPT_NODE;
  496.         task_types = set_new(0);
  497.     }
  498.  
  499.     entry_names = set_new(0);
  500.     entry_id = (char *) N_VAL(entry_node);
  501.     is_family = FALSE;
  502.  
  503.     FORSET(t = (Symbol), task_types, fs1);
  504.         if (is_access(t)) t = (Symbol) designated_type(t);
  505.  
  506.         e = dcl_get(DECLARED(t), entry_id);
  507.         if (e != (Symbol)0) {
  508.             if (NATURE(e) == na_entry) {
  509.                 FORSET(sym = (Symbol), OVERLOADS(e), fs2);
  510.                     entry_names = set_with(entry_names, (char *) sym);
  511.                 ENDFORSET(fs2);
  512.             }
  513.             else {    /* name of entry family*/
  514.                 entry_names = set_with(entry_names, (char *) e);
  515.                 is_family = TRUE;
  516.             }
  517.         }
  518.     ENDFORSET(fs1);
  519.  
  520.     if (set_size(entry_names) == 0 && entry_node != OPT_NODE ) {
  521.         errmsg("Undefined entry name in task : ", "9.5", obj_node);
  522.         entry_node = OPT_NODE;
  523.     }
  524.     else {
  525.         exists = FALSE;
  526.         if (set_size(entry_names) > 1 ) {
  527.             exists = FALSE;
  528.             FORSET(e = (Symbol), entry_names, fs2);
  529.                 if (NATURE(e) == na_entry_family ) {
  530.                     exists = TRUE;
  531.                     break;
  532.                 }
  533.             ENDFORSET(fs2);
  534.         }
  535.         if (exists) {
  536.             errmsg_id("ambiguous entry family name: %", e , "9.5", obj_node);
  537.             /* entry is undefined, this is a guess (gs sep 20) */
  538.             entry_node = OPT_NODE;
  539.         }
  540.         else if (entry_node != OPT_NODE) {
  541.             if (is_family) {
  542.                 N_KIND(obj_node)  = as_entry_family_name;
  543.                 N_UNQ(entry_node) = (Symbol)set_arb(entry_names);
  544.                 N_AST3(obj_node)  = index_node;
  545.             }
  546.             else {
  547.                 N_KIND(obj_node)  = as_entry_name;
  548.                 N_NAMES(obj_node) = entry_names;
  549.                 if (index_node != OPT_NODE ) {
  550.                     errmsg_id("invalid index. % is not an entry family", 
  551.                         (Symbol) set_arb(entry_names), "9.5", obj_node);
  552.                 }
  553.  
  554.             }
  555.         }
  556.     }
  557.     N_AST1(obj_node) = task_node;
  558.     N_AST2(obj_node) = entry_node;
  559. }
  560.  
  561. void terminate_statement(Node node)                    /*;terminate_statement*/
  562. {
  563.     /* A terminate alternative is annotated with the nesting level of the
  564.      * statement, to simplify the retrieval of the task environment.
  565.      */
  566.  
  567.     int    certain, exists, i, out_depth, j, blktyp;
  568.     Fortup    ft1;
  569.     Symbol    scope;
  570.  
  571.     exists = TRUE;
  572.     FORTUPI(scope = (Symbol), open_scopes, i, ft1);
  573.         if (NATURE(scope) == na_task_obj || NATURE(scope) == na_task_type) {
  574.             exists = TRUE;
  575.             break;
  576.         }
  577.     ENDFORTUP(ft1);
  578.     certain = exists;
  579.     if (!certain) {
  580.         errmsg("Invalid context for TERMINATE alternative", "9.7.1", node);
  581.         i = 1;
  582.     }
  583.     /* Loops and handlers are scopes for syntactic purposes, but not at run-
  584.      * time. Remove them from depth count.
  585.      */
  586.     out_depth = i - 1;
  587.     for (j = i; j > 0; j--) {
  588.         scope = (Symbol) open_scopes[j];
  589.         blktyp = (int) OVERLOADS(scope);
  590.         if (blktyp == BLOCK_LOOP || blktyp == BLOCK_HANDLER)
  591.             out_depth -= 1;
  592.     }
  593.     N_VAL(node) = (char *) out_depth;
  594. }
  595.  
  596. void abort_statement(Node node)                            /*;abort_statement*/
  597. {
  598.     Node    name_node;
  599.     Fortup    ft1;
  600.     Symbol    task_obj;
  601.     Set    task_types;
  602.     Symbol    t;
  603.  
  604.     if (cdebug2 > 3)
  605.         TO_ERRFILE("AT PROC :  abort_statement");
  606.  
  607.     FORTUP(name_node = (Node), N_LIST(node), ft1);
  608.         adasem(name_node);
  609.         find_old(name_node);
  610.         valid_task_name(name_node);
  611.         task_types = N_PTYPES(name_node);
  612.  
  613.         if (set_size(task_types) == 0)        /* Previous error*/
  614.             continue;
  615.         else if (!is_task_type( (t = (Symbol)set_arb (task_types), t) ) ) {
  616.             /* Access type not valid here.*/
  617.             errmsg(" expect task name is ABORT statement", "9.10", name_node);
  618.             continue;
  619.         }
  620.         else
  621.             resolve2(name_node, t);
  622.  
  623.         if (N_KIND(name_node) == as_simple_name
  624.           && NATURE(task_obj = N_UNQ(name_node)) == na_task_type ) {
  625.         /* This is a reference to the task currently executing the body.
  626.          * replace the name of the task type by its run-time identity.
  627.          */
  628.             if (in_open_scopes(task_obj))
  629.                 N_UNQ(name_node) = dcl_get(DECLARED(task_obj), "current_task");
  630.             else {
  631.                 errmsg("Invalid task type in ABORT statement", "9.10",
  632.                   name_node);
  633.             }
  634.         }
  635.     ENDFORTUP(ft1);
  636. }
  637.